﻿Imports Microsoft.Office.Interop.Excel
Imports System.Xml.Linq
Imports Microsoft.VisualBasic
Imports Microsoft.Office.Interop

Module Module1
    Dim app As New Application
    Dim theWrokbook As Workbook
    Dim sht As Worksheet
    Dim cfg As XElement
    Dim XMLCFG() As ChangeCfg
    Public savePath As String
    Class ChangeCfg

        Public WorkBookName As String
        Public SheetName As String
        Public WorkSheet As Worksheet
        Public SheetIndex As Int16
        Public EndRange(1) As Int64
        Public StartRange(1) As Int64
    End Class
    Sub Main()
        app = CreateObject("Excel.Application")
        app.Visible = False
        LoadCFG()
        Console.WriteLine("读取完成...")

        Dim NewWorkBook As Workbook = app.Workbooks.Add()
        Dim NewSheet As Worksheet = NewWorkBook.Sheets(1)
        NewSheet.Name = "Sheet1"

        Console.WriteLine("========================================")
        Console.WriteLine()
        Console.WriteLine("开始合并...请不要关闭程序...")
        'XMLCFG(0).WorkSheet.Range("A5:b10").Copy()
        'NewSheet.Range("A1:A1").PasteSpecial()
        ' NewSheet.SaveAs(savePath)
        Dim x As Int64 = 1
        For i = 0 To UBound(XMLCFG)
            XMLCFG(i).WorkSheet.Range(XMLCFG(i).WorkSheet.Cells(XMLCFG(i).StartRange(0), XMLCFG(i).StartRange(1)), XMLCFG(i).WorkSheet.Cells(XMLCFG(i).EndRange(0), XMLCFG(i).EndRange(1))).Copy()
            NewSheet.Range("A" & x & ":A" & x).PasteSpecial()
            x += XMLCFG(i).EndRange(0) - XMLCFG(i).StartRange(0) + 1
        Next
        NewSheet.SaveAs(savePath)

        app.Quit()
        Console.WriteLine("合并完成...按任意键退出")
        Console.ReadKey()
    End Sub
    Sub LoadCFG()
        cfg = XElement.Load(System.Environment.CurrentDirectory & "\ExcelCombineCfg.xml")
        Dim XMlElement As XElement
        Dim c As Int16 = 0
        savePath = cfg.Element("Save").Attribute("WorkBook").Value
        Dim EndRangeX As String
        Dim EndRangeY As String
        Dim EndRangeOffsetX As Int32
        Dim EndRangeOffsetY As Int32
        Dim sarr() As String
        For Each XMlElement In cfg.Elements
            If UCase(XMlElement.Name.ToString) = UCase("Item") Then

                ReDim Preserve XMLCFG(c)
                XMLCFG(c) = New ChangeCfg
                theWrokbook = app.Workbooks.Add(XMlElement.Attribute("WorkBook").Value)

                XMLCFG(c).WorkBookName = XMlElement.Attribute("WorkBook").Value
                XMLCFG(c).SheetName = XMlElement.Attribute("SheetName").Value
                XMLCFG(c).SheetIndex = Int(Val(XMlElement.Attribute("SheetIndex").Value))

                sarr = Split(XMlElement.Attribute("StartRange").Value, ",")
                If UBound(sarr) > 0 Then
                    XMLCFG(c).StartRange(0) = Int(sarr(0))
                    XMLCFG(c).StartRange(1) = Int(sarr(1))
                Else
                    XMLCFG(c).StartRange(0) = EnglishToROW(sarr(0))
                    XMLCFG(c).StartRange(1) = EnglishToColumns(sarr(0))
                    'Stop
                End If


                EndRangeX = Split(XMlElement.Attribute("EndRange").Value, ",")(0)
                EndRangeY = Split(XMlElement.Attribute("EndRange").Value, ",")(1)
                EndRangeOffsetX = Int(Split(XMlElement.Attribute("EndRangeOffset").Value, ",")(0))
                EndRangeOffsetY = Int(Split(XMlElement.Attribute("EndRangeOffset").Value, ",")(1))
                If XMLCFG(c).SheetIndex > 0 Then
                    XMLCFG(c).SheetName = theWrokbook.Worksheets(XMLCFG(c).SheetIndex).name

                End If
                XMLCFG(c).WorkSheet = theWrokbook.Worksheets(XMLCFG(c).SheetName)
                Select Case EndRangeX
                    Case "@LastRow"
                        XMLCFG(c).EndRange(0) = theWrokbook.Worksheets(XMLCFG(c).SheetName).usedrange.Rows.Count + EndRangeOffsetX
                    Case Else
                        XMLCFG(c).EndRange(0) = Int(EndRangeX) + EndRangeOffsetX
                End Select

                Select Case EndRangeY
                    Case "@LastRange"
                        XMLCFG(c).EndRange(1) = theWrokbook.Worksheets(XMLCFG(c).SheetName).usedrange.columns.Count + EndRangeOffsetY
                    Case Else
                        XMLCFG(c).EndRange(1) = Int(EndRangeY) + EndRangeOffsetY
                End Select
                Console.WriteLine(theWrokbook.Name & Chr(9) &
                    XMLCFG(c).SheetName & Chr(9) &
                   "起始位置:(" & ColumnsToEnglish(XMLCFG(c).StartRange(1)) & XMLCFG(c).StartRange(0) & ")" &
                   Chr(9) & "结束位置:(" & ColumnsToEnglish(XMLCFG(c).EndRange(1)) & XMLCFG(c).EndRange(0) & ")")
                'Stop
                c = c + 1

            End If
        Next

    End Sub

    'Sub Main()
    '    EnglishToColumns("A")

    '    EnglishToColumns("Z")

    '    EnglishToColumns("AA")
    '    cfg = XElement.Load(System.Environment.CurrentDirectory & "\ExcelCombineCfg.xml")
    '    Dim XMlElement As XElement
    '    Dim c As Int16 = 0
    '    savePath = cfg.Element("Save").Attribute("WorkBook").Value
    '    Dim EndRangeX As String
    '    Dim EndRangeY As String
    '    Dim EndRangeOffsetX As Int32
    '    Dim EndRangeOffsetY As Int32
    '    Dim sarr() As String
    '    For Each XMlElement In cfg.Elements
    '        If UCase(XMlElement.Name.ToString) = UCase("Item") Then

    '            ReDim Preserve XMLCFG(c)
    '            XMLCFG(c) = New ChangeCfg
    '            theWrokbook = app.Workbooks.Add(XMlElement.Attribute("WorkBook").Value)
    '            XMLCFG(c).WorkBookName = XMlElement.Attribute("WorkBook").Value
    '            XMLCFG(c).SheetName = XMlElement.Attribute("SheetName").Value
    '            XMLCFG(c).SheetIndex = Int(Val(XMlElement.Attribute("SheetIndex").Value))

    '            sarr = Split(XMlElement.Attribute("StartRange").Value, ",")
    '            If UBound(sarr) > 0 Then
    '                XMLCFG(c).StartRange(0) = Int(sarr(0))
    '                XMLCFG(c).StartRange(1) = Int(sarr(1))
    '            Else

    '            End If


    '            EndRangeX = Split(XMlElement.Attribute("EndRange").Value, ",")(0)
    '            EndRangeY = Split(XMlElement.Attribute("EndRange").Value, ",")(1)
    '            EndRangeOffsetX = Int(Split(XMlElement.Attribute("EndRangeOffset").Value, ",")(0))
    '            EndRangeOffsetY = Int(Split(XMlElement.Attribute("EndRangeOffset").Value, ",")(1))
    '            If XMLCFG(c).SheetIndex > 0 Then
    '                XMLCFG(c).SheetName = theWrokbook.Worksheets(XMLCFG(c).SheetIndex).name

    '            End If
    '            XMLCFG(c).WorkSheet = theWrokbook.Worksheets(XMLCFG(c).SheetName)
    '            Select Case EndRangeX
    '                Case "@LastRow"
    '                    XMLCFG(c).EndRange(0) = theWrokbook.Worksheets(XMLCFG(c).SheetName).usedrange.Rows.Count + EndRangeOffsetX
    '                Case Else
    '                    XMLCFG(c).EndRange(0) = Int(EndRangeX) + EndRangeOffsetX
    '            End Select

    '            Select Case EndRangeY
    '                Case "@LastRange"
    '                    XMLCFG(c).EndRange(1) = theWrokbook.Worksheets(XMLCFG(c).SheetName).usedrange.columns.Count + EndRangeOffsetY
    '                Case Else
    '                    XMLCFG(c).EndRange(1) = Int(EndRangeY) + EndRangeOffsetY
    '            End Select
    '            Console.WriteLine(theWrokbook.Name & Chr(9) & "起始位置:(" & ColumnsToEnglish(XMLCFG(c).StartRange(1)) & XMLCFG(c).StartRange(0) & ")" &
    '               Chr(9) & "结束位置:(" & ColumnsToEnglish(XMLCFG(c).EndRange(1)) & XMLCFG(c).EndRange(0) & ")")
    '            'Stop
    '            c = c + 1

    '        End If
    '    Next

    '    Dim NewWorkBook As _Workbook = app.Workbooks.Add()
    '    Dim NewSheet As Worksheet = NewWorkBook.Sheets(1)
    '    NewSheet.Name = "Sheet1"
    '    Dim R As Int64 = 1
    '    Dim x As Int64 = 1
    '    Dim cell1(1) As Object
    '    Dim cell2(1) As Object
    '    Dim range As Ranges
    '    Dim Nrange As Range
    '    Dim copyRange(,) As Object
    '    Console.WriteLine("开始合拼工作表...")
    '    If cfg.Element("Option").Attribute("CellsTypeCopy").Value = "1" Then

    '        For i = 0 To UBound(XMLCFG)
    '            range = XMLCFG(i).WorkSheet.Range(XMLCFG(i).WorkSheet.Cells(XMLCFG(i).StartRange(0), XMLCFG(i).StartRange(1)), XMLCFG(i).WorkSheet.Cells(XMLCFG(i).EndRange(0), XMLCFG(i).EndRange(1)))
    '            For DX = XMLCFG(i).StartRange(0) To XMLCFG(i).EndRange(0)
    '                For y = XMLCFG(i).StartRange(1) To XMLCFG(i).EndRange(1)
    '                    NewSheet.Cells(x, y).numberformatlocal = XMLCFG(i).WorkSheet.Cells(DX, y).numberformatlocal
    '                    NewSheet.Cells(x, y) = XMLCFG(i).WorkSheet.Cells(DX, y)
    '                Next

    '                x = x + 1
    '            Next
    '        Next
    '    Else

    '        For i = 0 To UBound(XMLCFG)

    '            For DX = XMLCFG(i).StartRange(0) To XMLCFG(i).EndRange(0)
    '                For y = XMLCFG(i).StartRange(1) To XMLCFG(i).EndRange(1)
    '                    NewSheet.Cells(x, y) = XMLCFG(i).WorkSheet.Cells(DX, y)
    '                Next

    '                x = x + 1
    '            Next
    '            NewSheet.Range(RowColumToEnglish(x, 1)) = range
    '        Next
    '    End If

    '    NewWorkBook.SaveAs(savePath)
    '    Console.WriteLine(System.Environment.CurrentDirectory & "\Test.xlsx" & "......完成!")
    '    app.Quit()
    '    Console.ReadKey()

    'End Sub
    Function RowColumToEnglish(Row As Int64, column As Int64) As String
        Dim s As String
        s = ColumnsToEnglish(column) & Row
        Return s
    End Function
    Function ColumnsToEnglish(column As Int64) As String
        'A:65
        'Z:90
        Dim H As Int64
        Dim c As Int64
        Dim s As String = ""
        Dim ac As Int64
        H = Int((column - 1) / 26)
        c = (column - 1) Mod 26
        ac = 65 + c
        For i = 1 To H
            s = s & "A"
        Next
        s = s & Chr(ac)

        Return s
    End Function
    Function ColumnsToEnglish(column As String) As String
        'A:65
        'Z:90
        Dim H As Int64
        Dim c As Int64
        Dim s As String = ""
        Dim ac As Int64
        H = Int((Val(column) - 1) / 26)
        c = (Int(column) - 1) Mod 26
        ac = 65 + c
        For i = 1 To H
            s = s & "A"
        Next
        s = s & Chr(ac)

        Return s
    End Function

    Function EnglishToColumns(eng As String) As Int64
        'Stop
        Dim ueng As String = UCase(eng)
        Dim ac As Int64
        Dim column As Int64 = 0
        Dim EG(0) As Int64
        Dim CCC = 0
        For Each c In ueng
            If Asc(c) >= 65 Then
                ReDim Preserve EG(CCC)
                EG(CCC) = (Asc(c) - 65) Mod 26
                CCC = CCC + 1
            End If
        Next
        For I = 1 To UBound(EG)
            column += I * 26
        Next
        column += EG(0) + 1
        ' Console.WriteLine(eng & "::column::" & column)
        Return column
    End Function
    Function EnglishToROW(eng As String) As Int64
        'Stop
        Dim ueng As String = UCase(eng)
        Dim ac As Int64
        Dim RS As String
        Dim ROW As Int64 = 0
        Dim EG(0) As Int64
        Dim CCC = 0
        For Each c In ueng
            If Asc(c) < 65 Then
                RS = RS & c
            End If
        Next

        ROW = Int(RS)
        'Console.WriteLine(eng & "::ROW::" & ROW)
        Return ROW
    End Function
End Module
